perm filename WAVE.F4[RST,LCS] blob sn#153749 filedate 1975-07-17 generic text, type T, neo UTF8
00100	C******  WAVE.F4 -----  LOAD WITH NEWIO.FAI -------
00200	C  CAN PROCESS UP TO 4.5 SECS. OF SOUND IN MUSIC.MUS
00300		DIMENSION K(15000),NJ(3)
00400		EQUIVALENCE (KA,NJ(1)),(KK,NJ(2)),(KM,NJ(3))
00500		DATA SRATE/10417./,I/5/
00700		TYPE 1
00800		JOUT=5
00850		X=1.
00900		CN=2.
01000		ACCEPT 2,XA
01010		TYPE 14
01020	14	FORMAT(' SKIP APPROX. HOW MANY SMPLS?   '$)
01030		ACCEPT 2,FRST
01040		MF=FRST/3.
01100		TYPE 11
01200		ACCEPT 2,T
01250		IF(T.NE.0)GO TO 17
01300		TYPE 12
01400		ACCEPT 2,POS
01500	17	TYPE 13
01600		ACCEPT 2,STP
01610		IF(T.NE.0)GO TO 16
01710		TYPE 15
01720	15	FORMAT(' WAVE WIDTH IN INCHES--  '$)
01730		ACCEPT 2,YDIV
01740		YDIV=4096./YDIV
01750		IF(YDIV.EQ.0)YDIV=2000.
01770	16	FORMAT(' LENGTH FACTOR--1,2 OR 3--  '$)
01775		TYPE 16
01780		ACCEPT 2,X
01785		I=5
01787		IF(STP.NE.0)I=STP
01790		X=X/100.
01795		IF(X.EQ.0)X=.01
01800	18	M=XA
01900		L=M/3.
02000	C  M=NUM OF SMPLS,  L=NUM OF WDS.
02100		IF(T.NE.0)JOUT=T
02200		IF(T.NE.0)T=-1
02300		IF(POS.NE.0)CN=POS
02500		IF(T)YDIV=1.
02600	
02700	1	FORMAT(' TYPE SMPLS  '$)
02800	11	FORMAT(' 0=PLT, 5=TTY, 3=LPT   '$)
02900	12	FORMAT(' INCHES FROM RT. ON PLTR.  '$)
03000	13	FORMAT(' HOW MANY SMPLS PER PLT. POINT?  '$)
03100	2	FORMAT(5F)
03200		XL=0
03300		NLL=0
03400		J='MUSIC'
03500		CALL GETFI2(J)
03510		IF(MF.NE.0)CALL FASTI2(K,MF)
03520	C SKIPS OVER MF WORDS.
03600		CALL FASTI2(K,L)
03700		IF(T)GO TO 3
03800		CALL PLOTS(N)
03900		CALL PLOT(0.,CN,-3)
04000	3	DO 4 N=1,L
04100		CALL UNPACK(K(N),KA,KK,KM)
04200	C  UNPACKS  12 BIT SMPLS
04300		DO 4 NN=1,3
04400		NLL=NLL+1
04500		IF(MOD(NLL,I).NE.0)GO TO 4
04600		KL=NJ(NN)
04700		IF(KL.GT.2047)KL=KL-4095
04800		AX=KL/YDIV
04900		XL=XL+X
05000		IF(T)GO TO 5
05100		CALL PLOT(XL,AX,2)
05200		GO TO 4
05300	5	WRITE(JOUT, 10)XL,AX
05400		IF(ABS(AX).GT.1000.)PAUSE
05500	4	CONTINUE
05600		IF(T)CALL EXIT
05700		CALL PLOT(0.,0.,3)
05800	10	FORMAT(2F10.4)
05900		END